Autoevaluación Módulo 4
1.Análisis discriminante
Se dispone información acerca de 16 clientes a los que se les concedió un préstamo instantáneo por un importe de 12.000 euros cada uno. Una vez pasados tres años desde la concesión de los préstamos había 8 clientes, de ese grupo de 16, que fueron clasificados como fallidos, mientras que los otros 8 clientes son cumplidores, ya que reintegraron el préstamo. Para cada uno de los clientes se dispone de información sobre su patrimonio neto y deudas pendientes correspondientes al momento de la solicitud. Con la información sobre las variabes de patrimonio neto y deudas pendientes se desea construir una función discriminante que clasifique con los menores errores posibles a los clientes en dos grupos: fallidos y no fallidos.
Librerías utilizadas y justificación
MASS: contiene la función lda() que utilizaremos para construir la función discriminante lineal y clasificar las observaciones.
ggplot2: permite visualizar la distribución de las variables y crear gráficos bivariantes que nos ayudarán a explorar la separación entre grupos.
dplyr: facilita la manipulación de los datos, filtrado, mutación y agrupaciones de forma clara y estructurada.
tibble: permite trabajar con data frames de forma más moderna y legible, especialmente útil para mantener estructuras limpias.
ggpubr: mejora la presentación visual de los gráficos generados con ggplot2, facilitando su combinación y anotación.
klar: ofrece funciones gráficas como partimat() para representar las fronteras de decisión generadas por modelos discriminantes.
caret: proporciona herramientas para evaluar el rendimiento del modelo, generar matrices de confusión y aplicar validación cruzada.
# Creamos los vectores con los datos proporcionados
Patrimonio <- c(1.3, 3.7, 5, 5.9, 7.1, 4, 7.9, 5.1, 5.2, 9.8, 9, 12, 6.3, 8.7, 11.1, 9.9)
Deuda <- c(4.1, 6.9, 3, 6.5, 5.4, 2.7, 7.6, 3.8, 1, 4.2, 4.8, 2, 5.2, 1.1, 4.1, 1.6)
Grupo <- c(1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0)
# Creamos el tibble y convertimos Grupo a factor
datos <- tibble(Patrimonio, Deuda, Grupo = as.factor(Grupo))
# Creamos los dos nuevos clientes a clasificar
nuevos <- tibble(
Patrimonio = c(10.1, 9.7),
Deuda = c(6.8, 2.2),
Grupo = factor(c(NA, NA), levels = c("0", "1"))
)
Antes de aplicar el modelo de análisis discriminante lineal,
realizamos una exploración gráfica de las variables. Representamos las
distribuciones de patrimonio neto y deuda por separado, diferenciando
los grupos de clientes cumplidores y fallidos. Esto nos permite analizar
visualmente si las variables presentan patrones diferenciados que
justifiquen la clasificación supervisada mediante LDA.
# Gráfico de densidad para Patrimonio
ggplot(datos, aes(x = Patrimonio, fill = Grupo)) +
geom_density(alpha = 0.5) +
labs(title = "Distribución de Patrimonio por Grupo",
x = "Patrimonio Neto", y = "Densidad") +
scale_fill_manual(values = c("#00AFBB", "#E7B800"),
labels = c("Cumplidores", "Fallidos")) +
theme_minimal()# Gráfico de densidad para Deuda
ggplot(datos, aes(x = Deuda, fill = Grupo)) +
geom_density(alpha = 0.5) +
labs(title = "Distribución de Deuda por Grupo",
x = "Deuda Pendiente", y = "Densidad") +
scale_fill_manual(values = c("#00AFBB", "#E7B800"),
labels = c("Cumplidores", "Fallidos")) +
theme_minimal()
A continuación, representamos gráficamente las variables
patrimonio neto y deuda de forma conjunta, diferenciando los grupos de
clientes cumplidores y fallidos. Esta visualización nos permite observar
la disposición relativa de los grupos en el plano bidimensional y
valorar si existe una separación suficiente para que un modelo lineal
pueda discriminar entre ellos.
# Calculamos los centroides por grupo
centroides <- datos %>%
group_by(Grupo) %>%
summarise(Patrimonio = mean(Patrimonio), Deuda = mean(Deuda))
# Gráfico bivariante
ggplot(datos, aes(x = Patrimonio, y = Deuda, color = Grupo)) +
geom_point(size = 3, alpha = 0.8) +
geom_point(data = centroides, aes(x = Patrimonio, y = Deuda),
color = "black", size = 4, shape = 4, stroke = 2) +
labs(title = "Distribución bivariante: Patrimonio vs. Deuda",
x = "Patrimonio Neto", y = "Deuda Pendiente") +
scale_color_manual(values = c("#00AFBB", "#E7B800"),
labels = c("Cumplidores", "Fallidos")) +
theme_minimal()
Tras representar las distribuciones de patrimonio y deuda por grupo,
observamos que la variable patrimonio presenta una buena capacidad
discriminante: los clientes fallidos tienden a concentrarse en valores
más bajos de patrimonio, mientras que los cumplidores muestran una clara
concentración en niveles más altos. En cuanto a la deuda pendiente, las
distribuciones presentan mayor solapamiento, aunque también se aprecia
una ligera tendencia a que los cumplidores tengan menores niveles de
deuda.
El gráfico bivariante refuerza esta percepción: ambos grupos se distribuyen de forma relativamente diferenciada en el plano Patrimonio-Deuda, y los centroides aparecen claramente separados. Esta estructura sugiere que un modelo lineal de clasificación como el Análisis Discriminante Lineal (LDA) puede resultar adecuado, ya que parece existir una frontera aproximadamente lineal entre los grupos y no se observan grandes diferencias en la dispersión interna.
A continuación, aplicamos el modelo de análisis discriminante lineal (LDA) con el objetivo de obtener la función discriminante que mejor separe los grupos de clientes fallidos y cumplidores. A partir del modelo estimado, calculamos las medias de los valores proyectados en la dimensión discriminante para cada grupo ({z}_0 y {z}_1) y determinamos el punto de corte óptimo. Este umbral nos permitirá clasificar nuevas observaciones según su distancia relativa a cada grupo.
# Aplicamos el modelo LDA
modelo_lda <- lda(Grupo ~ Patrimonio + Deuda, data = datos)
# Mostramos el modelo para ver los coeficientes de la función discriminante
modelo_lda## Call:
## lda(Grupo ~ Patrimonio + Deuda, data = datos)
##
## Prior probabilities of groups:
## 0 1
## 0.5 0.5
##
## Group means:
## Patrimonio Deuda
## 0 9 3
## 1 5 5
##
## Coefficients of linear discriminants:
## LD1
## Patrimonio -0.4224919
## Deuda 0.3802226
# Obtenemos las puntuaciones discriminantes (valores proyectados en el eje LDA)
predicciones_entrenamiento <- predict(modelo_lda)
# Extraemos las puntuaciones discriminantes (LD1) para cada observación
z <- predicciones_entrenamiento$x[,1]
# Calculamos las medias discriminantes por grupo
z_barra <- tapply(z, datos$Grupo, mean)
z_barra## 0 1
## -1.225206 1.225206
# Calculamos el punto de corte como la media de los dos centroides
punto_corte <- mean(z_barra)
punto_corte## [1] 0
Tras ajustar el modelo de análisis discriminante lineal (LDA) sobre los datos disponibles, obtenemos la siguiente función discriminante:
Z = -0.4225 · Patrimonio + 0.3802 · Deuda
Esta función proyecta las observaciones sobre una dimensión lineal que maximiza la separación entre los grupos de clientes cumplidores y fallidos. En este eje, hemos calculado los valores medios para cada grupo, obteniendo:
{z}_0 = -1.2252 para el grupo 0 (cumplidores),
{z}_1 = 1.2252 para el grupo 1 (fallidos).
El punto de corte óptimo se determina como la media de ambos centroides proyectados, resultando en un valor de 0. Este umbral será el que utilicemos para clasificar nuevas observaciones: aquellas con Z > 0 serán clasificadas como fallidas, y aquellas con Z < 0 como cumplidoras.
Antes de aplicar el modelo a nuevos solicitantes, evaluamos su capacidad de clasificación sobre la muestra original. Para ello, comparamos las predicciones obtenidas mediante la función discriminante con las clases reales y calculamos la tasa de acierto (eficiencia del modelo). Este indicador nos permite valorar si el modelo ha aprendido correctamente la separación entre grupos.
# Creamos una tabla de contingencia entre predicción y clase real
tabla_confusion <- table(Predicho = predicciones_entrenamiento$class,
Real = datos$Grupo)
# Calculamos la eficiencia: aciertos / total
eficiencia <- sum(diag(tabla_confusion)) / sum(tabla_confusion)
eficiencia## [1] 0.9375
Para finalizar el análisis, representamos gráficamente la frontera de decisión generada por el modelo LDA mediante la función partimat() del paquete klaR. Esta herramienta permite visualizar de forma intuitiva cómo se separan los grupos en el espacio de las variables explicativas, y comprobar si la regla de decisión generada se ajusta adecuadamente a la estructura observada en los datos.
# Representamos la frontera de decisión
partimat(Grupo ~ Patrimonio + Deuda,
data = datos,
method = "lda",
col.mean = c("blue", "orange"),
col.correct = "gray80",
col.wrong = "red",
imageplot = FALSE)
Una vez formulada la función discriminante, estamos en disposición de aplicarla a nuevas observaciones. En este caso, el director de la entidad financiera nos proporciona dos nuevas solicitudes de préstamo, para las que se dispone de los valores de patrimonio neto y deuda pendiente en el momento de la solicitud. Utilizaremos la función discriminante obtenida para proyectar a cada uno de estos clientes y determinar si deberían ser clasificados como cumplidores o fallidos, basándonos en su posición relativa al punto de corte.
# Aplicamos el modelo LDA a los nuevos clientes
predicciones_nuevos <- predict(modelo_lda, newdata = nuevos)
# Mostramos las puntuaciones proyectadas y la clase predicha
predicciones_nuevos$x # Valores de Z (proyección sobre LD1)## LD1
## 1 -0.2451015
## 2 -1.8251289
## [1] 0 0
## Levels: 0 1
# Creamos un resumen conjunto
resultado_nuevos <- nuevos %>%
select(Patrimonio, Deuda) %>%
mutate(Z = predicciones_nuevos$x[,1],
Clasificacion = predicciones_nuevos$class)
resultado_nuevos## # A tibble: 2 × 4
## Patrimonio Deuda Z Clasificacion
## <dbl> <dbl> <dbl> <fct>
## 1 10.1 6.8 -0.245 0
## 2 9.7 2.2 -1.83 0
Aplicamos la función discriminante obtenida a los dos nuevos solicitantes de préstamo. El primer cliente presenta un patrimonio de 10,1 y una deuda de 6,8, obteniendo una puntuación discriminante de Z = -0.2451. El segundo cliente tiene un patrimonio de 9,7 y una deuda de 2,2, con una puntuación de Z = -1.8251.
Ambos valores se encuentran por debajo del punto de corte establecido (0), por lo que ambos solicitantes han sido clasificados como cumplidores según el modelo. En consecuencia, la entidad financiera podría considerar conceder el préstamo a ambos perfiles, al presentar características similares a los clientes que anteriormente reintegraron el préstamo con éxito.
2.Análisis factorial
Comenzamos el análisis factorial cargando las librerías necesarias y leyendo el fichero Excel que contiene los datos de la encuesta de atención hospitalaria. Nos centramos en las variables P1 a P7, que son las que se analizarán a lo largo del ejercicio. Estas variables representan ítems relacionados con la percepción del usuario sobre el servicio recibido y serán la base del análisis factorial.
# Leemos el fichero Excel y seleccionamos solo las variables P1 a P7
datos <- read_excel("datos_atencion hospitalaria.xlsx")
datos_factorial <- datos %>%
select(P1, P2, P3, P4, P5, P6, P7)
# Previsualización de las primeras filas del dataset
head(datos_factorial)## # A tibble: 6 × 7
## P1 P2 P3 P4 P5 P6 P7
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 3 4 4 4 4 2 1
## 2 2 3 3 4 4 5 4
## 3 2 2 4 4 4 1 2
## 4 4 3 3 3 3 4 4
## 5 5 5 2 2 2 3 3
## 6 4 3 3 3 3 3 2
## vars n mean sd median trimmed mad min max range skew kurtosis se
## P1 1 100 3.50 1.17 3.5 3.51 2.22 1 5 4 -0.06 -1.36 0.12
## P2 2 100 3.29 1.09 3.0 3.24 1.48 2 5 3 0.15 -1.36 0.11
## P3 3 100 2.91 1.32 3.0 2.89 1.48 1 5 4 0.09 -1.20 0.13
## P4 4 100 3.21 1.18 3.0 3.21 1.48 1 5 4 -0.01 -1.04 0.12
## P5 5 100 3.36 1.05 3.0 3.33 1.48 2 5 3 0.08 -1.24 0.10
## P6 6 100 3.32 1.30 3.0 3.34 1.48 1 5 4 0.00 -1.40 0.13
## P7 7 100 2.85 1.08 3.0 2.94 1.48 1 4 3 -0.18 -1.45 0.11
## P1 P2 P3 P4 P5 P6
## P1 1.00000000 0.8258960 -0.088544771 -0.16449386 -0.15660073 0.16612267
## P2 0.82589602 1.0000000 0.291185482 0.24890683 0.19839108 0.28869518
## P3 -0.08854477 0.2911855 1.000000000 0.89261229 0.86291404 0.04047998
## P4 -0.16449386 0.2489068 0.892612288 1.00000000 0.90653011 0.07397738
## P5 -0.15660073 0.1983911 0.862914043 0.90653011 1.00000000 0.09966732
## P6 0.16612267 0.2886952 0.040479978 0.07397738 0.09966732 1.00000000
## P7 0.11649969 0.3201771 0.004624162 0.06462720 0.03039552 0.84182591
## P7
## P1 0.116499690
## P2 0.320177069
## P3 0.004624162
## P4 0.064627196
## P5 0.030395525
## P6 0.841825907
## P7 1.000000000
# Visualización gráfica
if (!require("corrplot")) install.packages("corrplot")
library(corrplot)
corrplot(correl, type = "lower", method = "circle", tl.col = "black")
## Hacer un Análisis factorial con las variables P1, P2, P3, P4,
P5, P6 y P7.
Antes de aplicar el análisis factorial, evaluamos si los datos cumplen las condiciones necesarias para su aplicación. Para ello, analizamos la matriz de correlaciones entre las variables, calculamos el índice KMO para valorar la adecuación de la muestra y aplicamos el test de esfericidad de Bartlett para comprobar si existen correlaciones significativas entre las variables. Si ambos indicadores son satisfactorios, podremos justificar la aplicación del análisis factorial.
# Matriz de correlaciones
correlaciones <- cor(datos_factorial, use = "pairwise.complete.obs")
correlaciones## P1 P2 P3 P4 P5 P6
## P1 1.00000000 0.8258960 -0.088544771 -0.16449386 -0.15660073 0.16612267
## P2 0.82589602 1.0000000 0.291185482 0.24890683 0.19839108 0.28869518
## P3 -0.08854477 0.2911855 1.000000000 0.89261229 0.86291404 0.04047998
## P4 -0.16449386 0.2489068 0.892612288 1.00000000 0.90653011 0.07397738
## P5 -0.15660073 0.1983911 0.862914043 0.90653011 1.00000000 0.09966732
## P6 0.16612267 0.2886952 0.040479978 0.07397738 0.09966732 1.00000000
## P7 0.11649969 0.3201771 0.004624162 0.06462720 0.03039552 0.84182591
## P7
## P1 0.116499690
## P2 0.320177069
## P3 0.004624162
## P4 0.064627196
## P5 0.030395525
## P6 0.841825907
## P7 1.000000000
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_factorial)
## Overall MSA = 0.58
## MSA for each item =
## P1 P2 P3 P4 P5 P6 P7
## 0.39 0.45 0.82 0.70 0.76 0.49 0.42
# Test de esfericidad de Bartlett
bartlett_resultado <- cortest.bartlett(correlaciones, n = nrow(datos_factorial))
bartlett_resultado## $chisq
## [1] 668.5095
##
## $p.value
## [1] 5.914187e-128
##
## $df
## [1] 21
Tras analizar la matriz de correlaciones entre las variables, observamos la existencia de relaciones moderadas y fuertes entre ciertos pares de ítems, como ocurre entre P3, P4 y P5, o entre P6 y P7, lo que sugiere la presencia de estructuras latentes comunes.
Sin embargo, el índice de adecuación muestral KMO presenta un valor global de 0.58, lo que indica que la muestra no es óptima para realizar un análisis factorial. Además, algunos ítems como P1, P2, P6 y P7 muestran índices individuales muy bajos (inferiores a 0.50), lo que sugiere que podrían no compartir suficiente varianza con el resto.
Por otro lado, el test de esfericidad de Bartlett arroja un valor de p < 0.001, indicando que la matriz de correlaciones no es una matriz identidad, por lo que existe correlación significativa entre las variables y, en principio, es factible aplicar un análisis factorial.
En conclusión, a pesar de que el índice KMO indica ciertas limitaciones en la adecuación de los datos, la existencia de correlaciones relevantes y la significación del test de Bartlett justifican la aplicación del análisis factorial, aunque los resultados deberán interpretarse con cautela.
Procedemos a realizar el análisis factorial sobre las 7 variables seleccionadas. En primer lugar, determinamos el número óptimo de factores a extraer mediante el criterio de Kaiser, el gráfico de sedimentación (Scree plot) y el análisis paralelo. A continuación, aplicamos el análisis factorial con rotación Varimax, que nos permitirá interpretar mejor los factores obtenidos.
# Análisis paralelo para decidir número de factores
fa.parallel(datos_factorial, fa = "fa", fm = "ml", n.iter = 100,
show.legend = TRUE, main = "Análisis paralelo y Scree plot")## Parallel analysis suggests that the number of factors = 3 and the number of components = NA
Para determinar el número óptimo de factores, hemos aplicado el análisis paralelo con 100 iteraciones, comparando los autovalores reales con los generados aleatoriamente. Observamos que los tres primeros factores presentan autovalores superiores a los simulados, por lo que decidimos extraer tres factores. A continuación, aplicamos el análisis factorial con método de máxima verosimilitud y rotación Varimax para facilitar la interpretación.
# Análisis factorial con extracción de 3 factores, método ML + rotación Varimax
modelo_3f <- fa(datos_factorial, nfactors = 3, rotate = "varimax", fm = "ml")
# Matriz de cargas factoriales con corte en 0.3
print(modelo_3f$loadings, cutoff = 0.3)##
## Loadings:
## ML3 ML2 ML1
## P1 0.913
## P2 0.942
## P3 0.922
## P4 0.973
## P5 0.929
## P6 0.837
## P7 0.992
##
## ML3 ML2 ML1
## SS loadings 2.747 1.747 1.741
## Proportion Var 0.392 0.250 0.249
## Cumulative Var 0.392 0.642 0.891
## P1 P2 P3 P4 P5 P6 P7
## 0.861 0.995 0.856 0.950 0.866 0.713 0.995
## P1 P2 P3 P4 P5 P6 P7
## 0.139 0.005 0.144 0.050 0.134 0.287 0.005
## ML3 ML2 ML1
## SS loadings 2.7474075 1.7472221 1.7405461
## Proportion Var 0.3924868 0.2496032 0.2486494
## Cumulative Var 0.3924868 0.6420899 0.8907394
## Proportion Explained 0.4406303 0.2802202 0.2791495
## Cumulative Proportion 0.4406303 0.7208505 1.0000000
** Varianza explicada:**
Cada factor explica aproximadamente un 25–39% de la varianza.
El modelo en conjunto explica el 89.1% de la varianza total → es un resultado excelente para un análisis factorial con 3 factores.
Tras aplicar el análisis factorial con tres factores, observamos una estructura muy clara en la que cada variable presenta una carga elevada sobre un único factor, sin solapamientos. Las comunalidades son en todos los casos superiores al umbral recomendado de 0.30, indicando que los factores explican adecuadamente la varianza de cada variable. Además, el modelo explica un 89.1% de la varianza total, lo que refuerza su solidez. En consecuencia, no se considera necesario eliminar ninguna variable.
Presente en una tabla la comunalidad y especificidad de cada variable.
# Comunalidades (h2) y especificidades (u2) a partir del modelo ML
comunalidades <- round(modelo_3f$communality, 3)
especificidades <- round(1 - comunalidades, 3)
# Creamos tabla unificada
tabla_comunalidad <- data.frame(
Variable = names(comunalidades),
Comunalidad = comunalidades,
Especificidad = especificidades
)
# Mostramos la tabla
tabla_comunalidad## Variable Comunalidad Especificidad
## P1 P1 0.861 0.139
## P2 P2 0.995 0.005
## P3 P3 0.856 0.144
## P4 P4 0.950 0.050
## P5 P5 0.866 0.134
## P6 P6 0.713 0.287
## P7 P7 0.995 0.005
En la siguiente tabla se recogen las comunalidades y especificidades de cada una de las variables utilizadas en el análisis factorial. La comunalidad (h²) representa la proporción de varianza de cada variable explicada por los tres factores extraídos, mientras que la especificidad (u²) indica la parte de la varianza no explicada por el modelo. Todas las variables presentan comunalidades elevadas, lo que confirma su buena adecuación al modelo factorial estimado mediante el método de máxima verosimilitud.
Realice una interpretación de factores con los que está trabajado. He indique que porcentaje de la varianza total explican.
Aplicando el análisis factorial mediante el método de máxima verosimilitud (ML) con rotación Varimax, obtenemos una solución de tres factores con una estructura clara y consistente. A continuación, interpretamos cada uno de ellos según el contenido de los ítems que los definen y las cargas factoriales observadas:
- Factor 1 (ML1): Atención técnica cualificada
Este factor agrupa con cargas muy elevadas a los ítems P6 (atención del personal médico) y P7 (información recibida), lo que indica que representa la calidad de la atención técnica proporcionada por personal especializado. Explica un 24.9% de la varianza.
- Factor 2 (ML2): Servicios generales del hospital
Este factor está compuesto por P1 (estado de las habitaciones) y P2 (comida), ambos con cargas superiores a 0.91. Se interpreta como una dimensión relacionada con la percepción de los servicios no sanitarios ofrecidos por el hospital. Explica un 25.0% de la varianza.
- Factor 3 (ML3): Atención del personal no médico
Este factor agrupa los ítems P3 (atención del personal no sanitario), P4 (personal auxiliar) y P5 (enfermería), todos ellos con cargas superiores a 0.92. Refleja la calidad de la atención del personal no médico en la experiencia del paciente. Explica un 39.2% de la varianza.
La varianza total explicada por el modelo es del 89.1%, lo que confirma la solidez y coherencia de la estructura factorial obtenida. La distribución de las variables entre los tres factores concuerda con la lógica teórica del contenido de la encuesta.
Realice un b_plot con cada uno de los factores seleccionados, y comente los resultados.
A continuación representamos gráficamente las cargas factoriales de las variables sobre los factores extraídos, utilizando un biplot. Este gráfico permite observar visualmente la relación entre los ítems y los factores, así como la agrupación de las variables en torno a cada dimensión latente.
El gráfico biplot nos permite observar visualmente las puntuaciones de
los individuos en los tres factores extraídos, junto con la
representación de las variables en forma de vectores. Este panel permite
analizar simultáneamente la distribución de las puntuaciones factoriales
y la proyección de las variables sobre cada eje factorial.
Se observa que:
El primer factor (ML1) está fuertemente definido por las variables P6 y P7, correspondientes a la atención médica e información recibida.
El segundo factor (ML2) agrupa a las variables P1 y P2, relacionadas con los servicios generales del hospital (habitaciones y comida).
El tercer factor (ML3) está dominado por las variables P3, P4 y P5, que recogen la percepción sobre el personal no médico.
Esta representación gráfica refuerza la interpretación conceptual que habíamos extraído anteriormente a partir de las cargas factoriales.
Obtenga las puntuaciones de los nuevos factores, obtenga una única puntuación, realice con el resultado un análisis estadístico descriptivo, y un histograma. Comente el resultado,
Una vez extraídos e interpretados los factores, calculamos las puntuaciones factoriales individuales para cada observación. Estas puntuaciones reflejan el grado en que cada sujeto se posiciona en cada uno de los factores extraídos. Posteriormente, agregamos las puntuaciones en una única medida global para obtener una representación general del nivel percibido por los encuestados. Finalmente, analizamos estadísticamente esta puntuación agregada y representamos su distribución mediante un histograma.
# Extraemos las puntuaciones de los factores
scores <- modelo_3f$scores
# Mostramos primeras y últimas observaciones
head(scores)## ML3 ML2 ML1
## [1,] 0.8585680 0.85305373 -1.80391789
## [2,] 0.5571158 -0.71544690 1.14887752
## [3,] 0.7189065 -1.26539620 -0.68649075
## [4,] -0.2798159 -0.43973701 1.10685161
## [5,] -0.9786403 1.88819637 -0.04460811
## [6,] -0.1771920 -0.03179318 -0.78409191
## ML3 ML2 ML1
## [95,] 1.4879602 1.7163924 -1.9016121
## [96,] -1.2486257 0.7782054 1.0075690
## [97,] -0.1073702 -1.2902640 0.2788824
## [98,] -0.9504526 -0.8602266 -0.6977540
## [99,] 1.2084496 1.0998792 0.9587105
## [100,] 0.2067775 -1.6150255 1.2340486
## ML3 ML2 ML1
## Min. :-1.7442 Min. :-1.68023 Min. :-1.9016
## 1st Qu.:-0.8546 1st Qu.:-0.79911 1st Qu.:-0.7841
## Median :-0.1566 Median :-0.03179 Median : 0.1767
## Mean : 0.0000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7204 3rd Qu.: 0.89992 3rd Qu.: 1.0076
## Max. : 1.5782 Max. : 1.88820 Max. : 1.2340
# Correlaciones entre factores
library(corrplot)
corrplot(cor(scores), type = "lower", method = "circle", tl.col = "black")# Histogramas individuales
hist(scores[,1], main = "Histograma ML1", xlab = "Puntuación", col = "red")# Puntuación ponderada por R² (Multiple R2)
# La matriz R2.scores representa la bondad de ajuste de cada factor
ponderacion <- as.matrix(scores) %*% as.matrix(modelo_3f$R2.scores)
colnames(ponderacion) <- "IndiceGlobal"
# Resumen y distribución de la puntuación compuesta
summary(ponderacion)## IndiceGlobal
## Min. :-3.0353
## 1st Qu.:-0.9834
## Median :-0.2180
## Mean : 0.0000
## 3rd Qu.: 1.2991
## Max. : 3.4696
hist(ponderacion, main = "Histograma Índice Global", xlab = "Puntuación ponderada", col = "darkgreen")Tras extraer tres factores mediante análisis factorial con máxima verosimilitud, hemos calculado las puntuaciones individuales de cada encuestado en cada dimensión latente. Los factores extraídos muestran independencia entre sí y representan de forma clara tres áreas diferenciadas: atención técnica cualificada (ML1), servicios generales del hospital (ML2) y atención del personal no médico (ML3).
El análisis estadístico de las puntuaciones revela que las valoraciones se distribuyen de manera simétrica en las tres dimensiones, aunque la atención del personal no médico presenta mayor dispersión, lo que podría señalar una experiencia menos uniforme en esta área.
Finalmente, mediante una puntuación compuesta ponderada por el R² de cada factor, hemos obtenido un índice global que permite sintetizar la valoración general de cada encuestado. Esta métrica, centrada en cero y con buena dispersión, resulta útil para clasificar, comparar o segmentar a los usuarios en futuros análisis.
3.Escalamiento Multidimensional
En este ejercicio vamos a aplicar técnicas de escalamiento multidimensional no métrico con el objetivo de analizar la similitud en la evolución de las tasas de paro registradas en la provincia de Cantabria desde 2005 hasta el primer trimestre de 2020.
El análisis nos permitirá representar gráficamente la proximidad entre las series temporales, facilitando la interpretación de patrones comunes.
Finalmente, aplicaremos técnicas de clustering para agrupar aquellas series que compartan comportamientos similares a lo largo del tiempo.
Cargamos el fichero Excel con los datos de paro para la provincia de Cantabria. Inspeccionamos su estructura para identificar las columnas que contienen las tasas de paro y determinar si es necesario transformar el formato para aplicar el escalamiento multidimensional.
# Cargar el archivo Excel
ruta_archivo <- "datos_socioecconomica.xlsx"
datos_paro <- read_excel('/Users/oscar/Desktop/BIG DATA/2o TRIMESTRE/MODULO 4_Análisis de datos multivariantes 2/3_Autoevaluación/M04_Autoevalucion_OscarPorta/datos_socioeconomica.xlsx')
# Ver estructura y primeras filas
str(datos_paro)## tibble [61 × 18] (S3: tbl_df/tbl/data.frame)
## $ Ano : num [1:61] 2005 2005 2005 2005 2006 ...
## $ Trimestre : num [1:61] 1 2 3 4 1 2 3 4 1 2 ...
## $ Hombres.16-24 : num [1:61] 16.1 13.3 12.9 15.4 13.6 ...
## $ Hombres.25-54 : num [1:61] 6.09 5.55 5.19 4.91 3.97 ...
## $ Hombres.55-64 : num [1:61] 4.31 4.71 4.94 6.48 4.53 ...
## $ Hombres.Total : num [1:61] 6.92 6.15 5.99 6.08 4.91 ...
## $ Mujeres.16-24 : num [1:61] 26.1 24.9 16.3 23.4 22.7 ...
## $ Mujeres.25-54 : num [1:61] 13.75 12.85 8.23 9.91 9.16 ...
## $ Mujeres.55-64 : num [1:61] 5.82 4.19 3.36 2.13 3.36 ...
## $ Mujeres.Total : num [1:61] 14.28 13.4 8.69 10.73 10.1 ...
## $ Total.16-24 : num [1:61] 19.9 18.8 14.3 19 17.7 ...
## $ Total.25-54 : num [1:61] 9.28 8.54 6.45 7.03 6.2 ...
## $ Total.55-64 : num [1:61] 4.8 4.51 4.36 4.91 4.13 ...
## $ Total.Total : num [1:61] 9.89 9.15 7.1 8.04 7.11 ...
## $ Total.Jovenes : num [1:61] 17.1 15.3 10.9 14.7 11.9 ...
## $ Total.No cualificadas : num [1:61] 9.51 6.76 6.77 8.25 9.3 ...
## $ Parados Larga Duracion.16-67 : num [1:61] 9085 7245 6191 6080 4836 ...
## $ Parados Larga Duracion.Jovenes: num [1:61] 2968 2912 1373 1953 1468 ...
## # A tibble: 6 × 18
## Ano Trimestre `Hombres.16-24` `Hombres.25-54` `Hombres.55-64` Hombres.Total
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2005 1 16.1 6.09 4.31 6.92
## 2 2005 2 13.3 5.55 4.71 6.15
## 3 2005 3 12.9 5.19 4.94 5.99
## 4 2005 4 15.4 4.91 6.48 6.08
## 5 2006 1 13.6 3.97 4.53 4.91
## 6 2006 2 9.92 2.87 5.58 3.81
## # ℹ 12 more variables: `Mujeres.16-24` <dbl>, `Mujeres.25-54` <dbl>,
## # `Mujeres.55-64` <dbl>, Mujeres.Total <dbl>, `Total.16-24` <dbl>,
## # `Total.25-54` <dbl>, `Total.55-64` <dbl>, Total.Total <dbl>,
## # Total.Jovenes <dbl>, `Total.No cualificadas` <dbl>,
## # `Parados Larga Duracion.16-67` <dbl>,
## # `Parados Larga Duracion.Jovenes` <dbl>
Seleccionamos las columnas del dataset que contienen las tasas de paro para los diferentes grupos de edad y sexo. A continuación, calculamos la similitud entre las series temporales mediante la distancia Dynamic Time Warping (DTW), que permite comparar secuencias temporales que puedan estar desfasadas en el tiempo. Finalmente, visualizamos la matriz de distancias mediante un mapa de calor con dendrograma, que permite identificar visualmente los grupos de series más similares.
# Seleccionamos únicamente las columnas con tasas de paro
datos_eval <- datos_paro[ , 3:(ncol(datos_paro) - 2)]
# Calculamos la matriz de distancias DTW entre columnas (series temporales)
# NOTA: by_rows = FALSE indica que la comparación se hace por columnas (series)
distMatrix <- proxy::dist(datos_eval, method = "DTW", by_rows = FALSE)
# Representamos la matriz de distancias como un mapa de calor con dendrograma
heatmap(as.matrix(distMatrix), margins = c(10, 10), main = "Mapa de Calor: Similitud entre series de paro (DTW)")En el siguiente mapa de calor representamos la matriz de distancias DTW entre las distintas series de paro. Las celdas más claras indican mayor similitud entre la evolución temporal de las tasas de paro para los diferentes grupos, mientras que las oscuras representan trayectorias más divergentes. A través del dendrograma se identifican grupos coherentes, como los relacionados con los jóvenes (16–24 años), que muestran un comportamiento diferenciado respecto al resto de la población. Esta visualización resulta útil para explorar posibles patrones de agrupación de comportamiento a lo largo del tiempo.
Una vez obtenida la matriz de distancias entre las series temporales de paro mediante DTW, aplicamos un escalamiento multidimensional no métrico (NMDS) con el objetivo de representar estas distancias en un espacio bidimensional. Esta técnica permite conservar la estructura ordinal de las similitudes y visualizarla gráficamente. Evaluamos el ajuste del modelo a través del índice de stress, que indica el grado de distorsión entre las distancias originales y las proyectadas.
# Aplicamos el escalamiento multidimensional no métrico (NMDS)
socioeconomica_smacof <- mds(distMatrix, type = "ordinal")
# Mostramos el stress del modelo (debería ser bajo si el ajuste es bueno)
paste("Stress(%) = ", round(socioeconomica_smacof$stress * 100, 3))## [1] "Stress(%) = 0.536"
# Gráfico de configuración
plot(socioeconomica_smacof, plot.type = "confplot", main = "Configuración NMDS - Series de Paro")Con el fin de evaluar la calidad del ajuste del modelo NMDS, representamos dos gráficos: el stress plot y el gráfico de Shepard. Ambos permiten comprobar la fidelidad con la que las distancias originales han sido representadas en el espacio bidimensional. A continuación, aplicamos técnicas de agrupamiento (clustering) sobre las coordenadas obtenidas, utilizando un algoritmo jerárquico. Para determinar el número óptimo de grupos, analizamos la evolución del error intragrupo en un modelo k-means.
# Gráfico de stress: representación del ajuste del modelo
plot(socioeconomica_smacof, plot.type = "stressplot", main = "Stress Plot")# Shepard diagram: comparación entre distancias originales y representadas
plot(socioeconomica_smacof, plot.type = "Shepard", main = "Shepard Diagram")# Creamos matriz de distancias entre los puntos de la configuración (coordenadas NMDS)
d <- dist(socioeconomica_smacof$conf)^2
# Selección del número óptimo de clústers (codo del error intragrupo)
set.seed(123)
Errores <- NULL
K_Max <- 10
for (i in 1:K_Max) {
Errores[i] <- sum(kmeans(d[-1], centers = i)$withinss)
}
# Visualización del "codo"
err_df <- data.frame(
num_cl = 1:K_Max,
sum_err = Errores
)
library(ggplot2)
ggplot(err_df, aes(x = as.factor(num_cl), y = sum_err)) +
geom_line(group = 1) +
geom_point() +
labs(
title = "GRÁFICO SELECCIÓN NÚMERO DE CLÚSTERS",
x = "Número de clústers",
y = "Suma del Error"
) +
theme_bw()# Agrupamiento jerárquico con enlace promedio
hc <- hclust(d, method = "average")
# Representamos el dendrograma
plot(hc, main = "Dendrograma - Clustering jerárquico sobre configuración NMDS")El análisis del gráfico de codo sugiere que la partición óptima es de dos clústers, lo cual resulta coherente con la representación NMDS previa. Para realizar el agrupamiento final, optamos por un método jerárquico con enlace promedio, adecuado en este caso ya que estamos agrupando variables (series) y no observaciones. El dendrograma resultante confirma la existencia de dos grupos diferenciados de evolución en las tasas de paro, en línea con la diferenciación observada previamente entre jóvenes y población adulta.
Una vez identificado que existen dos grandes agrupaciones en la evolución de las tasas de paro, representamos gráficamente las series temporales que pertenecen a cada uno de estos grupos. En el primer grupo se encuentran las tasas correspondientes a la población joven, caracterizadas por una mayor variabilidad y valores más elevados. En el segundo grupo agrupamos el resto de tasas, asociadas a una evolución más estable y menos extrema.
# Series correspondientes a población joven
young_cols <- c("Total.Jovenes", "Mujeres.16-24", "Hombres.16-24", "Total.16-24")
young_data <- datos_eval %>%
select(all_of(young_cols))
young_data$idx <- 1:nrow(young_data)
youngdat <- young_data %>%
pivot_longer(cols = -idx) %>%
ggplot(aes(x = idx, y = value, group = name)) +
geom_line(col = "green4") +
facet_wrap(~ name, ncol = 2) +
labs(
title = "Tasa de Paro - Jóvenes",
x = "Periodo",
y = "Tasa de Paro"
) +
theme_bw()
print(youngdat)# Series correspondientes al resto de variables
resto_cols <- setdiff(names(datos_eval), young_cols)
resto_data <- datos_eval %>%
select(all_of(resto_cols))
resto_data$idx <- 1:nrow(resto_data)
restodat <- resto_data %>%
pivot_longer(cols = -idx) %>%
ggplot(aes(x = idx, y = value, group = name)) +
geom_line(col = "green4") +
facet_wrap(~ name, ncol = 2) +
labs(
title = "Tasa de Paro - Resto Tasas",
x = "Periodo",
y = "Tasa de Paro"
) +
theme_bw()
print(restodat)
Como paso final, representamos gráficamente las series temporales agrupadas por los clústers obtenidos en el modelo NMDS.
En el primer grupo se encuentran las tasas de paro correspondientes a la población joven, que presentan niveles de paro significativamente más elevados y una mayor volatilidad a lo largo del tiempo.
En cambio, el segundo grupo, que agrupa al resto de categorías poblacionales, muestra una evolución más moderada y estable en las tasas de desempleo.
Esta clasificación permite identificar dinámicas diferenciadas en el mercado laboral y puede ser útil para diseñar políticas específicas según el segmento poblacional afectado.
4. Correlación canónica
En este ejercicio vamos a aplicar un análisis de correlación canónica sobre el conjunto de datos Cars93, disponible en la librería MASS.
Nuestro objetivo es estudiar las relaciones entre dos grupos de variables:
por un lado, las características físicas de los automóviles (como el tamaño del motor, la longitud o el peso)
por otro, variables relacionadas con el precio y el rendimiento (precio medio, consumo en ciudad y carretera, y radio de giro).
El análisis nos permitirá identificar combinaciones lineales de variables que están altamente correlacionadas entre ambos grupos.
Comenzamos seleccionando los dos conjuntos de variables que van a formar parte del análisis. Por un lado, incluimos las variables relacionadas con el precio y el rendimiento del vehículo (grupo X): precio medio, consumo en ciudad, consumo en carretera y radio de giro. Por otro lado, seleccionamos las características físicas del vehículo (grupo Y): tamaño del motor, caballos de fuerza, longitud, distancia entre ejes, anchura, espacio del asiento trasero y peso. A continuación, visualizamos la matriz de correlación entre ambos bloques de variables para estudiar el patrón de relaciones antes de aplicar el análisis canónico.
# Seleccionamos los datos
datos4 <- Cars93
# Definimos las matrices de variables
X <- as.matrix(datos4[, c("Price", "MPG.city", "MPG.highway", "Turn.circle")])
Y <- as.matrix(datos4[, c("EngineSize", "Horsepower", "Length", "Wheelbase", "Width", "Rear.seat.room", "Weight")])
# Calculamos la matriz de correlaciones cruzadas
correl <- matcor(X, Y)
# Mostramos la matriz
correl## $Xcor
## Price MPG.city MPG.highway Turn.circle
## Price 1.0000000 -0.5945622 -0.5606804 0.3925899
## MPG.city -0.5945622 1.0000000 0.9439358 -0.6663889
## MPG.highway -0.5606804 0.9439358 1.0000000 -0.5936833
## Turn.circle 0.3925899 -0.6663889 -0.5936833 1.0000000
##
## $Ycor
## EngineSize Horsepower Length Wheelbase Width
## EngineSize 1.0000000 0.7321197 0.7802831 0.7324842 0.8671102
## Horsepower 0.7321197 1.0000000 0.5508647 0.4868542 0.6444134
## Length 0.7802831 0.5508647 1.0000000 0.8236504 0.8221479
## Wheelbase 0.7324842 0.4868542 0.8236504 1.0000000 0.8072134
## Width 0.8671102 0.6444134 0.8221479 0.8072134 1.0000000
## Rear.seat.room 0.5027498 0.2567315 0.5499578 0.6672586 0.4656176
## Weight 0.8450753 0.7387975 0.8062743 0.8718953 0.8749605
## Rear.seat.room Weight
## EngineSize 0.5027498 0.8450753
## Horsepower 0.2567315 0.7387975
## Length 0.5499578 0.8062743
## Wheelbase 0.6672586 0.8718953
## Width 0.4656176 0.8749605
## Rear.seat.room 1.0000000 0.5262505
## Weight 0.5262505 1.0000000
##
## $XYcor
## Price MPG.city MPG.highway Turn.circle EngineSize
## Price 1.0000000 -0.5945622 -0.5606804 0.3925899 0.5974254
## MPG.city -0.5945622 1.0000000 0.9439358 -0.6663889 -0.7100032
## MPG.highway -0.5606804 0.9439358 1.0000000 -0.5936833 -0.6267946
## Turn.circle 0.3925899 -0.6663889 -0.5936833 1.0000000 0.7784636
## EngineSize 0.5974254 -0.7100032 -0.6267946 0.7784636 1.0000000
## Horsepower 0.7882176 -0.6726362 -0.6190437 0.5612157 0.7321197
## Length 0.5036284 -0.6662390 -0.5428974 0.7389545 0.7802831
## Wheelbase 0.5008642 -0.6671076 -0.6153842 0.7233244 0.7324842
## Width 0.4560279 -0.7205344 -0.6403592 0.8178542 0.8671102
## Rear.seat.room 0.3114988 -0.3843469 -0.3666844 0.4663276 0.5027498
## Weight 0.6471790 -0.8431385 -0.8106581 0.7780431 0.8450753
## Horsepower Length Wheelbase Width Rear.seat.room
## Price 0.7882176 0.5036284 0.5008642 0.4560279 0.3114988
## MPG.city -0.6726362 -0.6662390 -0.6671076 -0.7205344 -0.3843469
## MPG.highway -0.6190437 -0.5428974 -0.6153842 -0.6403592 -0.3666844
## Turn.circle 0.5612157 0.7389545 0.7233244 0.8178542 0.4663276
## EngineSize 0.7321197 0.7802831 0.7324842 0.8671102 0.5027498
## Horsepower 1.0000000 0.5508647 0.4868542 0.6444134 0.2567315
## Length 0.5508647 1.0000000 0.8236504 0.8221479 0.5499578
## Wheelbase 0.4868542 0.8236504 1.0000000 0.8072134 0.6672586
## Width 0.6444134 0.8221479 0.8072134 1.0000000 0.4656176
## Rear.seat.room 0.2567315 0.5499578 0.6672586 0.4656176 1.0000000
## Weight 0.7387975 0.8062743 0.8718953 0.8749605 0.5262505
## Weight
## Price 0.6471790
## MPG.city -0.8431385
## MPG.highway -0.8106581
## Turn.circle 0.7780431
## EngineSize 0.8450753
## Horsepower 0.7387975
## Length 0.8062743
## Wheelbase 0.8718953
## Width 0.8749605
## Rear.seat.room 0.5262505
## Weight 1.0000000
Hemos calculado las matrices de correlación entre las variables del conjunto X (relacionadas con el precio y el funcionamiento del vehículo) y las del conjunto Y (asociadas a sus características físicas).
En la matriz de correlaciones internas de X ($Xcor), observamos que las variables de consumo en ciudad y carretera (MPG.city y MPG.highway) están fuertemente correlacionadas positivamente entre sí y negativamente con el precio y el radio de giro. Esto indica que los coches más caros y menos maniobrables tienden a consumir más combustible (es decir, tienen menor eficiencia).
En la matriz interna de Y ($Ycor), las variables físicas como longitud, peso, tamaño del motor y distancia entre ejes muestran correlaciones altas entre sí, lo que sugiere que los vehículos más grandes también tienden a ser más pesados y potentes.
La matriz de correlación cruzada ($XYcor) muestra cómo se relacionan las variables de X con las de Y. Observamos que el precio y el radio de giro están positivamente correlacionados con casi todas las variables físicas, mientras que el consumo (MPG) está negativamente correlacionado. Esto confirma que los coches más grandes, pesados y potentes tienden a ser más caros, menos maniobrables y menos eficientes.
A continuación, representamos gráficamente las correlaciones entre los dos grupos de variables mediante una matriz cruzada, lo que nos permite observar las asociaciones individuales entre cada par de variables. Luego aplicamos el análisis de correlación canónica (CCA), con el que obtenemos combinaciones lineales óptimas de variables en X e Y que maximizan su correlación mutua.
# Ejecutamos el análisis de correlación canónica
res.cc <- cc(X, Y)
# Mostramos los resultados
res.cc## $cor
## [1] 0.9318169 0.6663061 0.6271609 0.2633357
##
## $names
## $names$Xnames
## [1] "Price" "MPG.city" "MPG.highway" "Turn.circle"
##
## $names$Ynames
## [1] "EngineSize" "Horsepower" "Length" "Wheelbase"
## [5] "Width" "Rear.seat.room" "Weight"
##
## $names$ind.names
## [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"
## [16] "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30"
## [31] "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45"
## [46] "46" "47" "48" "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72" "73" "74" "75"
## [76] "76" "77" "78" "79" "80" "81" "82" "83" "84" "85" "86" "87" "88" "89" "90"
## [91] "91" "92" "93"
##
##
## $xcoef
## [,1] [,2] [,3] [,4]
## Price -0.04310858 0.10925900 0.03358494 -0.04068036
## MPG.city 0.05517547 0.07097054 -0.28203869 -0.52525853
## MPG.highway 0.01228722 -0.01381975 0.46364713 0.33802420
## Turn.circle -0.12724047 -0.20762282 0.14786895 -0.30923665
##
## $ycoef
## [,1] [,2] [,3] [,4]
## EngineSize -0.142930393 0.0179710876 0.505788513 -0.760826208
## Horsepower -0.005992437 0.0238236468 0.012087912 -0.005531174
## Length -0.008170011 0.0011923864 0.067773848 0.108421267
## Wheelbase -0.001044217 0.0905265364 0.114569374 -0.202832295
## Width 0.036172528 -0.3824806380 0.067615186 -0.109812878
## Rear.seat.room -0.003914288 -0.0077759502 -0.043902482 -0.169822635
## Weight -0.001056177 -0.0006514885 -0.004547599 0.002433563
##
## $scores
## $scores$xscores
## [,1] [,2] [,3] [,4]
## 1 0.573488474 0.17244058 -0.26620325 0.015241273
## 2 -0.789657912 1.51760447 -0.32141735 0.622422521
## 3 -0.332858131 1.32890543 -0.73092425 0.414432075
## 4 -0.758767346 2.19756228 -0.16005509 0.589839466
## 5 -0.466636995 1.09865496 0.88555123 0.060926204
## 6 -0.092378093 -0.89281412 1.16467162 0.362206315
## 7 -0.641860344 -0.71466842 0.93899844 0.407202772
## 8 -1.350984671 -1.19213816 0.93517629 -0.076777274
## 9 -0.764004254 0.10769865 0.51219953 0.154673216
## 10 -1.570698059 0.42495648 1.00887272 0.094212021
## 11 -1.930724837 0.80733226 1.33810034 -0.434698599
## 12 0.615455519 -0.37742848 2.11593899 1.497826548
## 13 0.549857768 -0.77592980 1.26934380 0.593902219
## 14 -0.523381935 -1.54506754 0.89543323 0.329844197
## 15 -0.053509235 -0.70667054 0.37826409 0.512517013
## 16 -0.818964241 -1.62345136 -0.95259285 -1.193071383
## 17 -0.779803917 -1.34688038 -1.78308058 -0.025099220
## 18 -0.690568557 -1.04748800 0.50861168 0.863032145
## 19 -1.657780891 0.85648172 0.83766433 -0.565291708
## 20 -0.228743355 -0.49067383 0.28061800 0.598050425
## 21 -0.078375131 -0.76945844 -0.50494996 -1.181192857
## 22 -1.240784856 -0.08075073 0.31759236 -1.766496635
## 23 1.743794579 0.73476206 -1.43142759 0.408997279
## 24 0.509622086 -0.65207522 -0.63604191 0.267602943
## 25 0.216414567 -0.68451108 -1.06625865 -0.273784319
## 26 -0.760626350 -0.95653745 -1.80290698 -0.835224943
## 27 -0.319632035 -1.12705439 -0.26336775 -0.769800588
## 28 -0.707246608 0.23118068 -0.76136459 -0.004564034
## 29 1.105506970 0.23204776 -0.73919698 -0.949990423
## 30 -0.267541073 -0.39234073 0.31084444 0.561438097
## 31 1.804500477 0.47241411 -1.90808891 -0.877531768
## 32 0.828120534 -0.38176012 -0.50843460 1.272916887
## 33 0.302631718 -0.90302908 -1.13342853 -0.192423590
## 34 0.001666231 -0.63570000 0.09622540 -0.012741512
## 35 0.460691614 -0.29992513 -0.36375413 -0.029468364
## 36 -1.303783629 -1.60919415 -1.22864344 -1.087054379
## 37 -0.226588894 -0.25067659 0.98632646 0.675615649
## 38 -0.853161570 -0.95469638 0.44497031 -0.056891798
## 39 2.670666091 1.20367264 1.92478584 -3.359915216
## 40 1.057371040 0.08671394 0.52765015 -0.782617100
## 41 0.095708622 0.11233450 0.44255460 -0.236626927
## 42 1.986832693 0.96408214 1.61835425 -3.379968578
## 43 -0.059622596 -0.55420685 0.66104713 -0.761535392
## 44 1.413803457 -0.01921721 -1.02812267 -0.469896240
## 45 0.764968709 -0.44983681 -0.69340153 1.464219246
## 46 1.301587594 0.18019225 0.20094146 1.671779463
## 47 -0.174282452 -1.17614240 -0.18629241 0.133851210
## 48 -1.994176963 2.18722788 -0.36865510 -1.672863273
## 49 -0.802085474 0.47155048 -0.68747772 -0.094060836
## 50 -0.997513962 1.47965785 -1.05718224 -0.415747011
## 51 -1.358751476 0.64602650 1.02917824 0.232486496
## 52 -1.762892857 0.29079477 1.25119928 -1.293706642
## 53 1.577260218 0.16590432 0.68867238 1.179233116
## 54 1.113058296 0.05406258 0.91363214 0.613748931
## 55 0.257939029 -0.35536119 1.30645725 -0.448062818
## 56 -0.291178682 -0.29323179 -1.13425263 0.577231060
## 57 -0.657240902 1.50129416 -0.23426652 1.513870209
## 58 -0.034979083 2.21623985 0.31044812 2.242309620
## 59 -1.814282086 4.85544982 0.18905331 -0.732649558
## 60 0.606537370 0.11055487 -2.22868336 -0.241901383
## 61 0.096867702 -0.50116573 -0.77792275 1.208115124
## 62 1.187413263 0.02445567 -0.80300836 -0.872697730
## 63 -1.101900593 -0.35891009 -0.30768226 -0.944478099
## 64 1.504471813 0.81121263 -1.19623780 -0.006008321
## 65 0.132926095 -0.52943047 -0.01092184 -0.717098288
## 66 -0.613122306 -0.76562823 -1.02012317 0.145992079
## 67 -0.459019375 -0.26098372 -0.67673269 -1.038602289
## 68 0.367292647 -0.57599720 0.23096948 0.019659369
## 69 -0.190308243 -0.96391101 1.05065284 -0.496697081
## 70 -0.956911682 -1.27382256 -0.84512104 -1.323248549
## 71 -0.637549487 -0.72559432 0.93563994 0.411270808
## 72 0.261032247 -0.53481489 0.07958748 0.170281364
## 73 1.579343539 0.12142488 2.15056193 1.143099970
## 74 0.415577761 -0.90918934 0.43240431 0.642550770
## 75 -0.635464231 -1.26099414 0.98275407 0.224075249
## 76 -0.427757366 -0.74452154 0.25023700 0.471980059
## 77 -0.924291686 -0.52895884 1.20777317 -0.048483193
## 78 -0.315614701 1.28520183 -0.74435823 0.430704220
## 79 0.650225131 -0.85869770 2.41560972 0.073190912
## 80 2.048132167 0.87595802 -0.73186178 -0.307395719
## 81 1.031225077 0.05521098 -1.19351298 0.499092196
## 82 0.295659454 0.43765165 -0.04486722 0.581284809
## 83 2.189805602 0.82546891 0.66024374 -2.057411031
## 84 1.423642812 0.12745879 0.18867162 -1.076036312
## 85 0.223523309 0.01652269 0.57714412 -0.366908739
## 86 0.156997449 0.03084134 -0.12226714 0.512166953
## 87 -0.725424926 -0.28750554 -1.64490321 -0.863739962
## 88 1.272922630 0.02470836 -0.01089343 1.895626114
## 89 -0.281840470 -0.04956487 -2.37087331 0.373245410
## 90 0.418235175 0.76558572 0.24026473 2.229934982
## 91 -0.078226071 0.77470472 -0.97315560 1.672107689
## 92 0.022786649 0.67297887 -0.30061230 0.825576288
## 93 -0.332063590 0.83142151 0.26363510 0.878876704
##
## $scores$yscores
## [,1] [,2] [,3] [,4]
## 1 0.54367677 0.486074996 0.50975610 -0.114911768
## 2 -0.98482076 1.407280844 0.81345545 -1.040297731
## 3 -0.56520418 1.204299354 -1.57468101 0.758094139
## 4 -0.61050178 0.391592104 -0.30063335 0.590341776
## 5 -1.14094034 1.785540694 -0.60281644 -0.147813952
## 6 0.41057508 -0.443712777 0.71236005 0.500577915
## 7 -0.72586270 -0.745486044 1.22506118 -0.610793310
## 8 -1.71927834 -1.945011398 1.34690218 -0.285035292
## 9 -0.75330983 -0.622153200 0.74011012 0.630803522
## 10 -1.32722534 0.517491070 1.94710089 -1.860961222
## 11 -2.11502116 1.944786090 1.27519154 -0.430470640
## 12 0.78707632 0.610684654 1.48209118 0.442775342
## 13 0.52550643 -0.170803836 0.59656376 0.582405867
## 14 -0.27668464 -1.711912934 0.56916744 1.392528078
## 15 0.07160450 -1.135469820 0.34681819 1.329907587
## 16 -0.80384161 -1.021859766 -1.49469465 -2.197006057
## 17 -1.17157663 -2.777599576 -1.37429146 -1.212170315
## 18 -1.36926640 -1.680915553 1.59949254 -0.108896940
## 19 -1.48370546 1.082193259 1.14221454 -1.775316112
## 20 -0.62860964 -1.008048309 0.97253950 -0.192152039
## 21 -0.10194504 0.441001907 -0.13912555 -0.543108123
## 22 -0.84804618 0.415121772 -0.25140239 0.283329047
## 23 1.28997171 0.019824095 0.95917599 0.025923835
## 24 0.81501397 -0.679759846 -0.67622569 0.337416243
## 25 0.35301046 -0.472216750 -0.50019800 -0.432619127
## 26 -0.54541359 -0.723242871 -2.12611425 -1.289819946
## 27 0.18208919 -0.822718336 -0.07273702 0.715061528
## 28 -1.59758031 1.674352033 -1.76528929 2.768048733
## 29 1.26356728 0.003536883 0.84548601 0.086762900
## 30 -0.98424567 0.471659139 1.90087846 -0.681156582
## 31 2.11261733 -0.010004420 -0.89378780 -2.236664506
## 32 0.81756240 0.291934325 0.15005360 -0.452999465
## 33 0.74989562 -0.732236614 0.02595498 -0.052614707
## 34 0.51512112 -0.500742433 -0.12132008 1.003785475
## 35 0.72828157 -0.754013539 0.82498413 0.272133856
## 36 -0.62425574 -0.063654270 -1.51017771 -3.139190607
## 37 -0.30479316 -0.671508494 -0.06898088 0.796634165
## 38 -1.42154623 -1.807497051 1.13800891 0.176250431
## 39 2.27115830 0.163577904 0.49550510 -2.108219808
## 40 1.19789269 -0.628960372 -0.58356652 -0.191764089
## 41 0.28589089 -0.057775956 0.17904410 0.262085873
## 42 1.17880320 0.263237215 1.22308167 -1.321832466
## 43 0.02006020 1.108003268 0.17019453 0.104288815
## 44 1.22331174 0.490971767 -0.56067588 0.844435469
## 45 0.69614124 0.545502443 -0.29533540 0.000848837
## 46 1.28306381 0.426695657 -0.11302920 0.735479975
## 47 0.35616781 -0.141555114 0.22090071 -0.283392106
## 48 -2.10143306 2.452436936 0.63414218 -0.382255128
## 49 -0.77020541 0.386161721 -1.04874938 1.282565118
## 50 -0.99686822 1.247966156 0.13643016 1.104996605
## 51 -0.97655515 -0.919029953 0.14503879 1.134565137
## 52 -1.75466024 -0.748687381 1.58692539 0.326681941
## 53 1.35830049 -0.358785508 -0.17550133 -0.827292800
## 54 1.01796572 0.174137717 0.33524002 -0.066303830
## 55 -0.01388452 0.590842580 0.47369822 -0.198508399
## 56 -0.77937660 -0.604023345 -1.36183288 0.573442637
## 57 -0.17206875 2.147507619 -0.43743977 0.105795874
## 58 0.28404989 0.772317493 -0.17346611 -0.547412395
## 59 -1.03974703 2.161202290 0.05955534 -0.343617382
## 60 1.09930468 0.254624010 -0.33635519 1.468242478
## 61 -0.71425959 -0.969622639 0.42926585 -0.083875721
## 62 1.31803698 -0.377440553 0.79950474 -0.154981195
## 63 -1.12495267 1.012327164 -1.24990150 1.129432293
## 64 0.91409175 0.089352863 -0.50153541 0.576400641
## 65 -0.04411226 0.972555402 -0.40456877 0.213880253
## 66 -1.06869768 -1.517131464 -2.68373786 0.943438658
## 67 -0.33411065 0.457763212 0.06186026 0.403598003
## 68 0.03285044 1.193319598 0.73832400 0.765468428
## 69 0.42801583 -0.831515914 0.80227309 0.523521931
## 70 -0.93456178 -1.002781583 -0.41031308 -0.462265780
## 71 -0.73794700 -0.752069608 1.24893255 -0.672194678
## 72 0.90952244 -0.674482986 -0.59862222 1.022337558
## 73 1.27740842 -0.357443873 0.79015789 0.536341494
## 74 0.73405737 0.550521527 0.92661370 0.693372138
## 75 -0.26502214 -2.090816413 0.84010417 1.607979002
## 76 -0.84787390 0.478036329 0.74633235 0.104592278
## 77 -0.56435688 -0.789198145 -0.44742730 -3.043643394
## 78 0.33663531 0.565109861 0.40625434 1.304448386
## 79 1.08893496 -0.686808268 0.78272176 -0.506249243
## 80 1.71616868 1.268980960 -1.48722748 -0.433079544
## 81 0.97950592 0.119611194 -0.07204829 0.595365900
## 82 0.09061204 0.388438767 -1.09091404 0.802567375
## 83 1.77152473 0.362345900 0.27844704 -0.678160699
## 84 1.65280432 -0.052836614 0.58660804 -0.397336952
## 85 0.33521866 -0.415891068 -0.78828565 0.972435885
## 86 0.17677362 -0.633577190 0.02072976 0.857507957
## 87 -0.68870808 -0.460218956 -2.35467767 -0.851971122
## 88 1.33322547 0.468280918 -0.38488003 0.021389490
## 89 -0.67605303 -1.456969708 -3.10982171 -0.687431077
## 90 0.17401755 0.602015134 -0.70417812 -0.169361224
## 91 0.14402854 1.635691982 -0.90866790 -1.463282773
## 92 0.17607143 0.248935826 0.08591301 0.934040039
## 93 -0.31805548 0.682345817 -0.57193125 0.034103338
##
## $scores$corr.X.xscores
## [,1] [,2] [,3] [,4]
## Price -0.7985077 0.5968262 0.06788744 -0.03969063
## MPG.city 0.8927990 0.1477631 0.23794477 -0.35278649
## MPG.highway 0.8351605 0.1083733 0.51104437 -0.17203453
## Turn.circle -0.8191302 -0.4769307 0.19260212 -0.25390387
##
## $scores$corr.Y.xscores
## [,1] [,2] [,3] [,4]
## EngineSize -0.8292589 -0.1274496 0.14074067 -0.0445090128
## Horsepower -0.8075114 0.2336283 0.05902454 0.0007286105
## Length -0.7549311 -0.1887275 0.22951172 0.0537477303
## Wheelbase -0.7523878 -0.1761902 0.04335175 -0.0576622880
## Width -0.7906897 -0.3062396 0.09680375 -0.0215698743
## Rear.seat.room -0.4650161 -0.1169981 0.02038383 -0.1136703998
## Weight -0.9031314 -0.1142115 -0.08681681 -0.0020127371
##
## $scores$corr.X.yscores
## [,1] [,2] [,3] [,4]
## Price -0.7440780 0.39785589 0.0434349 -0.00709763
## MPG.city 0.8319310 0.09826920 0.1480908 -0.09733541
## MPG.highway 0.7782199 0.07202961 0.3193668 -0.04946351
## Turn.circle -0.7632559 -0.31757228 0.1220890 -0.06183494
##
## $scores$corr.Y.yscores
## [,1] [,2] [,3] [,4]
## EngineSize -0.8899266 -0.1910516 0.22571229 -0.164054095
## Horsepower -0.8666458 0.3507820 0.09477050 0.005420179
## Length -0.8101314 -0.2829884 0.36742763 0.210614594
## Wheelbase -0.8073732 -0.2641144 0.07099922 -0.212050336
## Width -0.8485332 -0.4594099 0.15564052 -0.076908214
## Rear.seat.room -0.4963790 -0.1784893 0.03262522 -0.433920216
## Weight -0.9692011 -0.1711557 -0.13687502 -0.001786927
# Gráfico de barras con las correlaciones canónicas
corr_df <- data.frame(
num_dim = 1:length(res.cc$cor),
corr_val = res.cc$cor
)
ggplot(corr_df, aes(x = as.factor(num_dim), y = corr_val)) +
geom_col(fill = "green4") +
geom_text(aes(label = round(corr_val, 2)), vjust = -0.3, color = "red") +
labs(
title = "GRÁFICO SELECCIÓN NÚMERO DE DIMENSIONES",
x = "Dimensión",
y = "Correlación Canónica"
) +
theme_bw()# Gráfico de variables en el plano canónico (dimensiones 1 y 2)
plt.cc(res.cc, d1 = 1, d2 = 2, var.label = TRUE)
Representamos gráficamente las correlaciones canónicas obtenidas para evaluar cuántas dimensiones resultan relevantes. A partir del gráfico, confirmamos que las tres primeras dimensiones presentan valores elevados de correlación, siendo especialmente significativa la primera, con un valor superior a 0.93. Posteriormente, generamos los gráficos de variables e individuos asociados a las dos primeras dimensiones para facilitar su interpretación.
La primera dimensión contrapone a los vehículos de bajo consumo frente a los más caros y de mayor radio de giro (menos maniobrables). Estos últimos presentan una correlación positiva con todas las características físicas del vehículo, como tamaño, peso o potencia.
La segunda dimensión se relaciona positivamente con el precio y la potencia, y negativamente con el radio de giro y la anchura. Por tanto, esta dimensión parece recoger el perfil de vehículos caros, potentes, maniobrables y compactos, características habituales en los modelos deportivos.
La tercera dimensión recoge, principalmente, una fuerte correlación negativa con el consumo en carretera y una débil positiva con el peso, lo cual identifica a vehículos pensados para trayectos largos y con alta eficiencia.
En conclusión, el análisis de correlación canónica revela que existe una fuerte relación entre las características físicas de los vehículos y sus variables de precio, consumo y maniobrabilidad. Las tres primeras dimensiones extraídas permiten caracterizar diferentes perfiles de vehículo: utilitarios económicos, modelos grandes y potentes, y deportivos eficientes.